home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / editors / emcs1858 / 1858b-d3.zoo / e-lisp / st / compile.el next >
Encoding:
Text File  |  1992-06-12  |  9.5 KB  |  261 lines
  1. ;;
  2. ;;
  3. ;; Heavily hacked for the Atari ST/TT. 
  4. ;;
  5. ;;    (5/25/92)     
  6. ;;    (sjk)++ use shell-command instead of start-process, and remove 
  7. ;;            a considerable amount of the process interaction code.
  8. ;;            this works fine as long as the spawned off command just
  9. ;;            just does output, and does not do ANY input.
  10. ;;
  11. ;;    (5/27/92)
  12. ;;    (sjk)++ added some support from launch.el, for direct invokation of 
  13. ;;            commands without any shell involvment.
  14. ;;
  15. ;; Run compiler as inferior of Emacs, and parse its error messages.
  16. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
  17. ;;
  18.  
  19. (require 'launch-command "st/process")
  20.  
  21. (provide 'compile)
  22.  
  23. (defvar compilation-process nil
  24.   "Process created by compile command, or nil if none exists now.
  25. Note that the process may have been \"deleted\" and still
  26. be the value of this variable.")
  27.  
  28. (defvar compilation-error-list nil
  29.   "List of error message descriptors for visiting erring functions.
  30. Each error descriptor is a list of length two.
  31. Its car is a marker pointing to an error message.
  32. Its cadr is a marker pointing to the text of the line the message is about,
  33.   or nil if that is not interesting.
  34. The value may be t instead of a list;
  35. this means that the buffer of error messages should be reparsed
  36. the next time the list of errors is wanted.")
  37.  
  38. (defvar compilation-parsing-end nil
  39.   "Position of end of buffer when last error messages parsed.")
  40.  
  41. (defvar compilation-error-message nil
  42.   "Message to print when no more matches for compilation-error-regexp are found")
  43.  
  44. ;; The filename excludes colons to avoid confusion when error message
  45. ;; starts with digits.
  46. (defvar compilation-error-regexp
  47.   "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\)"
  48.   "Regular expression for filename/linenumber in error in compilation log.")
  49.  
  50. (defun compile (command)
  51.   "Compile the program including the current buffer.  Default: run `make'.
  52. Runs COMMAND, a shell command, in a separate process asynchronously
  53. with output going to the buffer *compilation*.
  54. You can then use the command \\[next-error] to find the next error message
  55. and move to the source code that caused it."
  56.   (interactive (list (read-string "Compile command: " compile-command)))
  57.   (setq compile-command (car (first-rest command)))
  58.   (compile1 (parse-string (car (cdr (first-rest command)))) "No more errors"))
  59.  
  60. (defun grep (command)
  61.   "Run grep, with user-specified args, and collect output in a buffer.
  62. While grep runs asynchronously, you can use the \\[next-error] command
  63. to find the text that grep hits refer to."
  64.   (interactive "sRun grep (with args): ")
  65.   (setq compile-command "grep")
  66.   (compile1 (parse-string command)
  67.         "No more grep hits" "grep"))
  68.  
  69. (defun compile1 (command error-message &optional name-of-mode)
  70.   (save-some-buffers)
  71.   (setq compilation-process nil)
  72.   (compilation-forget-errors)
  73.   (setq compilation-error-list t)
  74.   (setq compilation-error-message error-message)
  75.   (setq compilation-process
  76.     (launch-command compile-command command nil))
  77.   (let* ((thisdir default-directory)
  78.      (outbuf (get-buffer "*Compilation*"))
  79.      (outwin (get-buffer-window outbuf))
  80.      (regexp compilation-error-regexp))
  81.     (if (eq outbuf (current-buffer))
  82.     (goto-char (point-max)))
  83.     (save-excursion
  84.       (set-buffer outbuf)
  85.       (buffer-flush-undo outbuf)
  86.       (let ((start (save-excursion (set-buffer outbuf) (point-min))))
  87.     (set-window-start outwin start)
  88.     (or (eq outwin (selected-window))
  89.         (set-window-point outwin start)))
  90.       (setq default-directory thisdir)
  91.       (fundamental-mode)
  92.       (make-local-variable 'compilation-error-regexp)
  93.       (setq compilation-error-regexp regexp)
  94.       (setq mode-name (or name-of-mode "Compilation"))
  95.       ;; Make log buffer's mode line show process state
  96.       (setq mode-line-process '(": finished")))))
  97.  
  98. ;; Called when compilation process changes state.
  99.  
  100. (defun compilation-sentinel (proc msg))
  101.  
  102. (defun kill-compilation ())
  103.  
  104. (defun kill-grep ())
  105.  
  106. (defun next-error (&optional argp)
  107.   "Visit next compilation error message and corresponding source code.
  108. This operates on the output from the \\[compile] command.
  109. If all preparsed error messages have been processed,
  110. the error message buffer is checked for new ones.
  111. A non-nil argument (prefix arg, if interactive)
  112. means reparse the error message buffer and start at the first error."
  113.   (interactive "P")
  114.   (if (or (eq compilation-error-list t)
  115.       argp)
  116.       (progn (compilation-forget-errors)
  117.          (setq compilation-parsing-end 1)))
  118.  
  119.   (if compilation-error-list
  120.       nil
  121.     (save-excursion
  122.       (set-buffer "*Compilation*")
  123.       (set-buffer-modified-p nil)
  124.       (compilation-parse-errors)))
  125.   (let ((next-error (car compilation-error-list)))
  126.     (if (null next-error)
  127.     (error (concat compilation-error-message))
  128.     (setq compilation-error-list (cdr compilation-error-list))
  129.     (if (null (car (cdr next-error)))
  130.     nil
  131.       (switch-to-buffer (marker-buffer (car (cdr next-error))))
  132.       (goto-char (car (cdr next-error)))
  133.       (set-marker (car (cdr next-error)) nil))
  134.     (let* ((pop-up-windows t)
  135.        (w (display-buffer (marker-buffer (car next-error)))))
  136.       (set-window-point w (car next-error))
  137.       (set-window-start w (car next-error)))
  138.     (set-marker (car next-error) nil))))
  139.  
  140. ;; Set compilation-error-list to nil, and
  141. ;; unchain the markers that point to the error messages and their text,
  142. ;; so that they no longer slow down gap motion.
  143. ;; This would happen anyway at the next garbage collection,
  144. ;; but it is better to do it right away.
  145. (defun compilation-forget-errors ()
  146.   (if (eq compilation-error-list t)
  147.       (setq compilation-error-list nil))
  148.   (while compilation-error-list
  149.     (let ((next-error (car compilation-error-list)))
  150.       (set-marker (car next-error) nil)
  151.       (if (car (cdr next-error))
  152.       (set-marker (car (cdr next-error)) nil)))
  153.     (setq compilation-error-list (cdr compilation-error-list))))
  154.  
  155. (defun compilation-parse-errors ()
  156.   "Parse the current buffer as error messages.
  157. This makes a list of error descriptors, compilation-error-list.
  158. For each source-file, line-number pair in the buffer,
  159. the source file is read in, and the text location is saved in compilation-error-list.
  160. The function next-error, assigned to \\[next-error], takes the next error off the list
  161. and visits its location."
  162.   (setq compilation-error-list nil)
  163.   (message "Parsing error messages...")
  164.   (let (text-buffer
  165.     last-filename last-linenum)
  166.     ;; Don't reparse messages already seen at last parse.
  167.     (goto-char compilation-parsing-end)
  168.  
  169.     ;; Don't parse the first two lines as error messages.
  170.     ;; This matters for grep.
  171.     (if (bobp)
  172.     (forward-line 2))
  173.     (while (re-search-forward compilation-error-regexp nil t)
  174.       (let (linenum filename
  175.         error-marker text-marker)
  176.     ;; Extract file name and line number from error message.
  177.     (save-restriction
  178.       (narrow-to-region (match-beginning 0) (match-end 0))
  179.       (goto-char (point-max))
  180.       (skip-chars-backward "[0-9]")
  181.       ;; If it's a lint message, use the last file(linenum) on the line.
  182.       ;; Normally we use the first on the line.
  183.       (if (= (preceding-char) ?\()
  184.           (progn
  185.         (narrow-to-region (point-min) (1+ (buffer-size)))
  186.         (end-of-line)
  187.         (re-search-backward compilation-error-regexp)
  188.         (skip-chars-backward "^ \t\n")
  189.         (narrow-to-region (point) (match-end 0))
  190.         (goto-char (point-max))
  191.         (skip-chars-backward "[0-9]")))
  192.       ;; Are we looking at a "filename-first" or "line-number-first" form?
  193.       (if (looking-at "[0-9]")
  194.           (progn
  195.         (setq linenum (read (current-buffer)))
  196.         (goto-char (point-min)))
  197.         ;; Line number at start, file name at end.
  198.         (progn
  199.           (goto-char (point-min))
  200.           (setq linenum (read (current-buffer)))
  201.           (goto-char (point-max))
  202.           (skip-chars-backward "^ \t\n")))
  203.       (setq filename (compilation-grab-filename)))
  204.  
  205.     ;; Locate the erring file and line.
  206.     (if (and (equal filename last-filename)
  207.          (= linenum last-linenum))
  208.         nil
  209.       (beginning-of-line 1)
  210.       (setq error-marker (point-marker))
  211.       ;; text-buffer gets the buffer containing this error's file.
  212.       (if (not (equal filename last-filename))
  213.           (setq text-buffer
  214.             (and (file-exists-p (setq last-filename filename))
  215.              (find-file-noselect filename))
  216.             last-linenum 0))
  217.       (if text-buffer
  218.  
  219.           ;; Go to that buffer and find the erring line.
  220.           (save-excursion
  221.         (set-buffer text-buffer)
  222.         (if (zerop last-linenum)
  223.             (progn
  224.               (goto-char 1)
  225.               (setq last-linenum 1)))
  226.         ;; Move the right number of lines from the old position.
  227.         ;; If we can't move that many, put 0 in last-linenum
  228.         ;; so the next error message will be handled starting from
  229.         ;; scratch.
  230.         (if (eq selective-display t)
  231.             (or (re-search-forward "[\n\C-m]" nil 'end
  232.                        (- linenum last-linenum))
  233.             (setq last-linenum 0))
  234.           (or (= 0 (forward-line (- linenum last-linenum)))
  235.               (setq last-linenum 0)))
  236.         (setq last-linenum linenum)
  237.         (setq text-marker (point-marker))
  238.         (setq compilation-error-list
  239.               (cons (list error-marker text-marker)
  240.                 compilation-error-list)))))
  241.     (forward-line 1)))
  242.     (setq compilation-parsing-end (point-max)))
  243.   (message "Parsing error messages...done")
  244.   (setq compilation-error-list (nreverse compilation-error-list)))
  245.  
  246. (defun compilation-grab-filename ()
  247.   "Return a string which is a filename, starting at point.
  248. Ignore quotes and parentheses around it, as well as trailing colons."
  249.   (if (eq (following-char) ?\")
  250.       (save-restriction
  251.     (narrow-to-region (point)
  252.               (progn (forward-sexp 1) (point)))
  253.     (goto-char (point-min))
  254.     (read (current-buffer)))
  255.     (buffer-substring (point)
  256.               (progn
  257.             (skip-chars-forward "^ :,\n\t(")
  258.             (point)))))
  259.  
  260. (define-key ctl-x-map "`" 'next-error)
  261.